home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / games / 54 / stcastle.bas < prev    next >
BASIC Source File  |  1987-04-09  |  11KB  |  321 lines
  1.  
  2. 1000  ' Area Formula Castle Builder
  3. 1010  '   by Tracy and Lori Hershey
  4. 1020  '   (c) 1986 Antic Publishing, Inc.
  5. 1030  '   ST version by Bill Marquardt
  6. 1040  '   version 070286
  7. 1050  '
  8. 1060  '---------------------------------------------------------
  9. 1070   BASICON=0: BASICOFF=1: FALSE=0: TRUE=1: NONE=0: BELL$=chr$(7)
  10. 1080   dim YMIN( 9 ),YMAX( 9 ): gosub INIT
  11. 1090   poke GEMFLAG,BASICOFF
  12. 1100   TITLE$=" CASTLE GAME "
  13. 1110   gosub NEWTITLE
  14. 1120   poke GEMFLAG,BASICON
  15. 1130   MORE=TRUE
  16. 1140  '
  17. 1150  while MORE=TRUE
  18. 1160      restore CASTLE.DATA
  19. 1170      gosub INTRO
  20. 1180      gosub START
  21. 1190  '
  22. 1200      DRAW.CASTLE:
  23. 1210      color 1,8,1: clearw 2
  24. 1220      for I =1 to 12
  25. 1230           read X1,Y1,X2,Y2
  26. 1240           linef X1,Y1,X2,Y1: linef X2,Y1,X2,Y2
  27. 1250           linef X2,Y2,X1,Y2: linef X1,Y2,X1,Y1
  28. 1260      next I
  29. 1270      for I=1 to 4
  30. 1280           read X1,Y1,X2,Y2,X3,X4
  31. 1290           linef X1,Y2,X2,Y1: linef X2,Y1,X3,Y1
  32. 1300           linef X3,Y1,X4,Y2: linef X4,Y2,X1,Y2
  33. 1310      next I
  34. 1320      for I=1 to 2
  35. 1330           read X1,Y1,X2,Y2,Y3,Y4
  36. 1340           linef X1,Y2,X2,Y1: linef X2,Y1,X2,Y3
  37. 1350           linef X2,Y3,X1,Y4: linef X1,Y4,X1,Y2
  38. 1360      next I
  39. 1370      for I=1 to 4
  40. 1380           read X1,Y1,X2,Y2,X3,X4
  41. 1390           linef X1,Y2,X2,Y1: linef X2,Y1,X4,Y1
  42. 1400           linef X4,Y1,X3,Y2: linef X3,Y2,X1,Y2
  43. 1410      next I
  44. 1420      linef 83,20,83,0: linef 83,0,100,5
  45. 1430      linef 100,5,83,10
  46. 1440      for I=1 to 2
  47. 1450           read X1,Y1,X2,Y2: linef X1,Y1,X2,Y2
  48. 1460           linef X2,Y2,X1,Y2: linef X1,Y2,X1,Y1
  49. 1470      next I
  50. 1480      for I=1 to 4
  51. 1490           read X,Y,R
  52. 1500           circle X,Y,R
  53. 1510      next I
  54. 1520      for I=1 to 3
  55. 1530           read X,Y,R,A1,A2,X1,X2
  56. 1540           circle X,Y,R,A1,A2: linef X1,Y,X2,Y
  57. 1550      next I
  58. 1560  '
  59. 1570      ON ITEM gosub DO.SHAPES, DO.FORMULAS
  60. 1580  '
  61. 1590  DRAW.MENU.BOXES:
  62. 1600      color 1,0,1+ITEM
  63. 1610      X1=170: X2=300
  64. 1620      for I=1 to 8
  65. 1630           read Y1,Y2
  66. 1640           linef X1,Y1,X2,Y1: linef X2,Y1,X2,Y2
  67. 1650      next I
  68. 1660      color 1,8,1: fill 0,0: fill 100,0
  69. 1670  '
  70. 1680  '- - - - - - - - - - - - - - - - - - - - - - - - - -
  71. 1690  MAIN:
  72. 1700      NUM.WRONG=NONE
  73. 1710      XMIN=170: XMAX=300: NUM.CHOICES=7
  74. 1720      for I=1 to NUM.CHOICES
  75. 1730           YMIN(I)=32+(I*9): YMAX(I)=YMIN(I)+9
  76. 1740      next I
  77. 1750      for DRAW=1 to NUM.SHAPES
  78. 1760           RESPONSE=FALSE
  79. 1770           read SHAPE: gosub ERASE.SHAPE
  80. 1780           on SHAPE gosub DREC,DSQR,DPAR,DCIR,DTRA,DSEM,DTRI
  81. 1790           while RESPONSE=FALSE
  82. 1800                ITEM=NONE
  83. 1810                gosub GETBUTTON: if ITEM=SHAPE then RESPONSE=TRUE
  84. 1820                if(RESPONSE=FALSE)and(ITEM<>NONE)then gosub WRONG.ANS
  85. 1830           wend
  86. 1840           if RESPONSE=TRUE then ? BELL$;: color 1,COLR,1: fill XF,YF
  87. 1850      next DRAW
  88. 1860      gosub FINISH
  89. 1870   wend
  90. 1880  end
  91. 1890  '
  92. 1900  '---------------------------------------------------------
  93. 1910  FINISH:
  94. 1920   gosub ERASE.SHAPE
  95. 1930   gotoxy 19,10: ? "                "
  96. 1940   gotoxy 19,10: ? "You missed ";NUM.WRONG;"."
  97. 1950   gotoxy 19,11: ? "                "
  98. 1960   if NUM.WRONG=NONE then gotoxy 19,11:? "   VERY good!   "
  99. 1970   gotoxy 19,12: ? "   Try again?   "
  100. 1980   gotoxy 24,14: ? "NO ":gotoxy 24,16: ? "YES"
  101. 1990   color 1,2,2: linef 210,126,245,126: linef 245,126,245,136
  102. 2000   linef 245,136,210,136: linef 210,136,210,126
  103. 2010   color 1,3,3: linef 210,144,245,144: linef 245,144,245,154
  104. 2020   linef 245,154,210,154: linef 210,154,210,144
  105. 2030   YMIN(1)=148: YMAX(1)=158: YMIN(2)=166: YMAX(2)=176
  106. 2040   XMIN=210: XMAX=245: NUM.CHOICES=2: ITEM=NONE
  107. 2050   while ITEM=NONE: gosub GETBUTTON: wend
  108. 2060   if ITEM=1 then MORE=FALSE
  109. 2070  return
  110. 2080  '
  111. 2090  '---------------------------------------------------------
  112. 2100  WRONG.ANS:
  113. 2110   gotoxy 23,0: ? "SORRY!";
  114. 2120   SOUND 1,15,12,3,20: SOUND 1,0,0,0,0
  115. 2130   for DELAY=1 to 1000: next DELAY
  116. 2140   gotoxy 23,0: ? "      "
  117. 2150   color 1,8,1: fill 230,5: NUM.WRONG=NUM.WRONG+1
  118. 2160  return
  119. 2170  '
  120. 2180  '---------------------------------------------------------
  121. 2190  DREC:
  122. 2200   read COLR,X1,Y1,X2,Y2,XF,YF
  123. 2210   linef X1,Y1,X2,Y1: linef X2,Y1,X2,Y2
  124. 2220   linef X2,Y2,X1,Y2: linef X1,Y2,X1,Y1
  125. 2230  return
  126. 2240  '
  127. 2250  DSQR:
  128. 2260   gosub DREC
  129. 2270  return
  130. 2280  '
  131. 2290  DPAR:
  132. 2300   read COLR,X1,Y1,X2,Y2,Y3,Y4,XF,YF
  133. 2310   linef X1,Y2,X2,Y1: linef X2,Y1,X2,Y3
  134. 2320   linef X2,Y3,X1,Y4: linef X1,Y4,X1,Y2
  135. 2330  return
  136. 2340  '
  137. 2350  DCIR:
  138. 2360   read COLR,XC,YC,RAD,XF,YF
  139. 2370   circle XC,YC,RAD
  140. 2380  return
  141. 2390  '
  142. 2400  DTRA:
  143. 2410   read COLR,X1,Y1,X2,Y2,X3,X4,XF,YF
  144. 2420   linef X1,Y2,X2,Y1: linef X2,Y1,X3,Y1
  145. 2430   linef X3,Y1,X4,Y2: linef X4,Y2,X1,Y2
  146. 2440  return
  147. 2450  '
  148. 2460  DSEM:
  149. 2470   read COLR,XC,YC,RAD,XF,YF
  150. 2480   circle XC,YC,RAD,0,1800: linef XC-RAD,YC,XC+RAD,YC
  151. 2490  return
  152. 2500  '
  153. 2510  DTRI:
  154. 2520   read COLR,X1,Y1,X2,Y2,XF,YF
  155. 2530   linef X1,Y1,X2,Y2: linef X2,Y2,X1,Y2
  156. 2540   linef X1,Y2,X1,Y1
  157. 2550  return
  158. 2560  '
  159. 2570  '---------------------------------------------------------
  160. 2580  DO.SHAPES:
  161. 2590   gotoxy 19,2: ? "   RECTANGLE   "
  162. 2600   gotoxy 19,3: ? "    SQUARE     "
  163. 2610   gotoxy 19,4: ? " PARALLELOGRAM "
  164. 2620   gotoxy 19,5: ? "    CIRCLE     "
  165. 2630   gotoxy 19,6: ? "   TRAPEZOID   "
  166. 2640   gotoxy 19,7: ? "  SEMI-CIRCLE  "
  167. 2650   gotoxy 19,8: ? "   TRIANGLE    "
  168. 2660   gotoxy 19,10: ? "What's the name"
  169. 2670   gotoxy 19,11: ? "of this shape? "
  170. 2680  return
  171. 2690  '
  172. 2700  '---------------------------------------------------------
  173. 2710  DO.FORMULAS:
  174. 2720   gotoxy 20,2: ? "    W * L     "
  175. 2730   gotoxy 20,3: ? "     S^2      "
  176. 2740   gotoxy 20,4: ? "    B * H     "
  177. 2750   gotoxy 20,5: ? "   PI * R^2   "
  178. 2760   gotoxy 20,6: ? "1/2 * H *(B+T)"
  179. 2770   gotoxy 20,7: ? "1/2 * PI * R^2"
  180. 2780   gotoxy 20,8: ? " 1/2 * H * B  "
  181. 2790   gotoxy 19,10: ? "Formula for area"
  182. 2800   gotoxy 19,11: ? " of this shape?"
  183. 2810  return
  184. 2820  '
  185. 2830  '---------------------------------------------------------
  186. 2840  ERASE.SHAPE:
  187. 2850   color 1,0,0: X1=171: X2=299
  188. 2860   for Y=110 to 159: linef X1,Y,X2,Y: next Y
  189. 2870   color 1,0,1
  190. 2880  return
  191. 2890  '
  192. 2900  '---------------------------------------------------------
  193. 2910  INTRO:
  194. 2920   fullw 2: clearw 2: NUM.SHAPES=32
  195. 2930   gotoxy 2,3: ? "FORMULAS"
  196. 2940   gotoxy 20,3: ? "SHAPES"
  197. 2950   gotoxy 2,5: ? "W * L            = RECTANGLE"
  198. 2960   gotoxy 2,6: ? "S^2              = SQUARE"
  199. 2970   gotoxy 2,7: ? "B * H            = PARALLELOGRAM"
  200. 2980   gotoxy 2,8: ? "PI * R^2         = CIRCLE"
  201. 2990   gotoxy 2,9: ? "1/2 * H * (B+T)  = TRAPEZOID"
  202. 3000   gotoxy 2,10: ? "1/2 * PI * R^2   = SEMI-CIRCLE"
  203. 3010   gotoxy 2,11: ? "1/2 * H * B      = TRIANGLE"
  204. 3020   gotoxy 4,14: ? "Press mouse button to play.": gosub GETBUTTON
  205. 3030  return
  206. 3040  '
  207. 3050  '---------------------------------------------------------
  208. 3060  START:
  209. 3070   clearw 2
  210. 3080   gotoxy 4,4: ? "Would you like to try: "
  211. 3090   gotoxy 8,6: ? "    Shapes    "
  212. 3100   gotoxy 8,8: ? "   Formulas   "
  213. 3110   color 2,0,2
  214. 3120   linef 80,54,172,54: linef 172,54,172,65
  215. 3130   linef 172,65,80,65: linef 80,65,80,54
  216. 3140   color 3,0,3
  217. 3150   linef 80,72,172,72: linef 172,72,172,83
  218. 3160   linef 172,83,80,83: linef 80,83,80,72
  219. 3170   color 1,0,1: ITEM=NONE: NUM.CHOICES=2: XMIN=80:XMAX=172
  220. 3180   YMIN(1)=76: YMAX(1)=87: YMIN(2)=94: YMAX(2)=105
  221. 3190   while ITEM=NONE: gosub GETBUTTON
  222. 3200   wend:return
  223. 3210  '
  224. 3220  '---------------------------------------------------------
  225. 3230  CASTLE.DATA:
  226. 3240   data 10,75,155,150,78,120,93,150,15,30,35,65,130,30,150,65
  227. 3250   data 21,12,29,20,140,20,160,30,120,20,140,30,136,12,144,20
  228. 3260   data 5,20,25,30,25,20,45,30,83,45,115,75,50,45,83,75
  229. 3270   data 10,65,15,75,35,40,125,65,130,75,150,155
  230. 3280   data 93,140,103,150,145,155,10,140,20,150,68,78
  231. 3290   data 20,40,30,35,60,55,135,35,145,40,55,60
  232. 3300   data 36,12,41,20,45,49,5,12,0,20,14,8
  233. 3310   data 120,12,115,20,129,124,151,12,156,20,160,165
  234. 3320   data 83,20,115,45,83,20,50,45
  235. 3330   data 44,95,13,66,60,13
  236. 3340   data 99,60,13,124,95,13
  237. 3350   data 44,130,13,0,1800,31,57,124,130,13,0,1800,111,137
  238. 3360   data 85,97,13,0,1800,72,98
  239. 3370  '
  240. 3380  '---------------------------------------------------------
  241. 3390  BOX.DATA:
  242. 3400   data 18,27,27,36,36,45,45,54,54,63,63,72,72,81,90,160
  243. 3410  '
  244. 3420  '---------------------------------------------------------
  245. 3430  PROGRAM.DATA:
  246. 3440   data 1,6,200,135,240,150,11,76
  247. 3450   data 4,5,212,130,13,44,95
  248. 3460   data 5,7,200,130,210,150,240,250,104,141
  249. 3470   data 1,5,200,130,240,150,79,121
  250. 3480   data 6,7,212,130,13,123,129
  251. 3490   data 5,7,200,120,220,150,240,260,21,141
  252. 3500   data 4,5,212,130,17,124,95
  253. 3510   data 6,7,223,130,17,43,129
  254. 3520   data 1,2,200,125,220,150,16,31
  255. 3530   data 3,3,200,130,210,150,110,130,21,41
  256. 3540   data 2,3,200,130,205,135,22,13
  257. 3550   data 1,1,200,125,205,150,6,21
  258. 3560   data 3,3,200,130,210,150,110,130,6,13
  259. 3570   data 5,5,200,130,220,150,240,260,15,74
  260. 3580   data 1,1,200,130,245,150,26,21
  261. 3590   data 3,3,200,130,220,150,120,140,42,13
  262. 3600   data 2,5,210,130,234,150,51,46
  263. 3610   data 7,1,200,130,240,150,75,43
  264. 3620   data 2,5,200,130,225,150,84,46
  265. 3630   data 4,6,212,130,20,66,59
  266. 3640   data 1,2,200,120,210,150,131,31
  267. 3650   data 1,1,200,125,205,145,121,21
  268. 3660   data 3,3,200,130,220,150,120,140,120,13
  269. 3670   data 5,5,220,150,200,130,260,240,129,74
  270. 3680   data 1,1,200,135,245,145,141,21
  271. 3690   data 7,1,200,125,220,150,84,40
  272. 3700   data 3,3,200,130,220,150,120,140,140,50
  273. 3710   data 2,3,200,140,212,150,137,13
  274. 3720   data 3,3,200,130,210,150,110,130,155,16
  275. 3730   data 4,6,230,140,18,99,60
  276. 3740   data 6,7,230,140,18,84,96
  277. 3750   data 7,2,205,130,230,150,84,6
  278. 3760  '
  279. 3770  '---------------------------------------------------------
  280. 3780  GETBUTTON:
  281. 3790   while BUTTON=NONE: gosub GETMOUSE: wend: BUTTON=NONE
  282. 3800   if (MX>XMIN) and (MX<XMAX) then gosub YCHECK
  283. 3810  return
  284. 3820  '
  285. 3830  '---------------------------------------------------------
  286. 3840  YCHECK:
  287. 3850   ITEM=NONE
  288. 3860   for I=1 to NUM.CHOICES
  289. 3870      if (MY>YMIN(I)) and (MY<YMAX(I)) then ITEM=I
  290. 3880   next I
  291. 3890  return
  292. 3900  '
  293. 3910  '---------------------------------------------------------
  294. 3920  INIT:
  295. 3930   A#=GB
  296. 3940   GINTIN=peek(A#+8)
  297. 3950   OUTHANDLE=peek(SYSTAB+8)
  298. 3960   GEMFLAG=SYSTAB+24
  299. 3970  return
  300. 3980  '
  301. 3990  '---------------------------------------------------------
  302. 4000  NEWTITLE:
  303. 4010   poke GINTIN+0,OUTHANDLE
  304. 4020   poke GINTIN+2,2
  305. 4030   S# = GINTIN+4
  306. 4040   TITLE$ = TITLE$ + chr$( 0 )
  307. 4050   poke S#,varptr(TITLE$)
  308. 4060   GEMSYS( 105 )
  309. 4070  return
  310. 4080  '
  311. 4090  '---------------------------------------------------------
  312. 4100  GETMOUSE:
  313. 4110   poke CONTRL+0,124
  314. 4120   poke CONTRL+2,0
  315. 4130   poke CONTRL+6,0
  316. 4140   vdisys( 1 )
  317. 4150   BUTTON=peek( INTOUT )
  318. 4160   MX=peek( PTSOUT+0 )
  319. 4170   MY=peek( PTSOUT+2 )
  320. 4180  return
  321.